W raporcie wykorzystano następujące biblioteki:
library(knitr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(plotly)
library(ggcorrplot)
library(caret)
library(tibble)
Materials Project to inicjatywa naukowa Departamentu Energii USA, której celem jest dostarczanie otwartych danych i narzędzi do analizy materiałów. Jednym z kluczowych zbiorów danych dostępnych w ramach Materials Project jest baza danych dotycząca materiałów używanych w bateriach, która zawiera informacje o ich składzie chemicznym i parametrach wydajnościowych.
df <- read.csv("./data/mp_batteries.csv", na.strings="?")
df <- tbl_df(df)
| Nazwa atrybutu | Opis |
|---|---|
| Battery ID | Identyfikator baterii. |
| Battery Formula | Wzór chemiczny materiału baterii. |
| Working Ion | Główny jon, który odpowiada za transport ładunku w baterii. |
| Formula Charge | Wzór chemiczny materiału baterii w stanie naładowanym. |
| Formula Discharge | Wzór chemiczny materiału baterii w stanie rozładowanym. |
| Max Delta Volume | Zmiana objętości w % dla danego kroku napięcia za pomocą wzoru : max(charge, discharge)/min(charge, discharge) -1. |
| Average Voltage | Średnie napięcie dla poszczególnego kroku napięcia. |
| Gravimetric Capacity | Pojemność grawimetryczna, czyli ilość energii na jednostkę masy (mAh/g). |
| Volumetric Capacity | Pojemność wolumetryczna, czyli ilość energii na jednostkę objętości (mAh/cm³). |
| Gravimetric Energy | Gęstość energii w odniesieniu do masy baterii (Wh/kg). |
| Volumetric Energy | Gęstość energii w odniesieniu do objętości baterii (Wh/L). |
| Atomic Fraction Charge | Udział atomowy składników w stanie naładowanym. |
| Atomic Fraction Discharge | Udział atomowy składników w stanie rozładowanym. |
| Stability Charge | Wskaźnik stabilności materiału w stanie naładowanym. |
| Stability Discharge | Wskaźnik stabilności materiału w stanie rozładowanym. |
| Steps | Liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana, oparta na stabilnych stanach pośrednich. |
| Max Voltage Step | Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia. |
Poniżej znajduje się lista kroków wykonanych na zbiorze danych w celu przygotowania go do anaizy.
| Struktura ramki danych |
|---|
| tibble [4,351 × 17] (S3: tbl_df/tbl/data.frame) |
| $ Battery.ID : chr [1:4351] “mp-30_Al” “mp-1022721_Al” “mp-8637_Al” “mp-129_Al” … |
| $ Battery.Formula : chr [1:4351] “Al0-2Cu” “Al1-3Cu” “Al0-5Mo” “Al0-12Mo” … |
| $ Working.Ion : chr [1:4351] “Al” “Al” “Al” “Al” … |
| $ Formula.Charge : chr [1:4351] “Cu” “AlCu” “Mo” “Mo” … |
| $ Formula.Discharge : chr [1:4351] “Al2Cu” “Al3Cu” “Al5Mo” “Al12Mo” … |
| $ Max.Delta.Volume : num [1:4351] 3.04 1.24 4.76 12.72 12.49 … |
| $ Average.Voltage : num [1:4351] 0.089 -0.0216 0.1228 0.0431 0.0292 … |
| $ Gravimetric.Capacity : num [1:4351] 1368 1113 1742 2299 1901 … |
| $ Volumetric.Capacity : num [1:4351] 5563 4419 7176 7346 7333 … |
| $ Gravimetric.Energy : num [1:4351] 121.8 -24 213.8 99.1 55.6 … |
| $ Volumetric.Energy : num [1:4351] 495.3 -95.4 880.9 316.8 214.4 … |
| $ Atomic.Fraction.Charge : num [1:4351] 0 0.5 0 0 0 … |
| $ Atomic.Fraction.Discharge: num [1:4351] 0.667 0.75 0.833 0.923 0.923 … |
| $ Stability.Charge : num [1:4351] 0 0.0741 0.4115 0 0 … |
| $ Stability.Discharge : num [1:4351] 0 0.0962 0.0452 0.0114 0 … |
| $ Steps : int [1:4351] 1 1 1 1 1 1 1 1 1 1 … |
| $ Max.Voltage.Step : num [1:4351] 0 0 0 0 0 0 0 0 0 0 … |
Sprawdzenie ile jest pustych wartościami w poszczególnych kolumnach oraz ile w zbiorze jest zduplikowanych wierszy.
na_counts <- colSums(is.na(df))
kable(na_counts, col.names = c("Brakujące wartości"), caption = "Liczba brakujących wartości w kolumnach")
| Brakujące wartości | |
|---|---|
| Battery.ID | 0 |
| Battery.Formula | 0 |
| Working.Ion | 0 |
| Formula.Charge | 0 |
| Formula.Discharge | 0 |
| Max.Delta.Volume | 0 |
| Average.Voltage | 0 |
| Gravimetric.Capacity | 0 |
| Volumetric.Capacity | 0 |
| Gravimetric.Energy | 0 |
| Volumetric.Energy | 0 |
| Atomic.Fraction.Charge | 0 |
| Atomic.Fraction.Discharge | 0 |
| Stability.Charge | 0 |
| Stability.Discharge | 0 |
| Steps | 0 |
| Max.Voltage.Step | 0 |
duplicates_count <- sum(duplicated(df))
print(paste("Liczba zduplikowanych wierszy:", duplicates_count))
## [1] "Liczba zduplikowanych wierszy: 0"
Z powodu braku zduplikowanych danych oraz braku wartości pustych w zbiorze - dane nie wymagają czyszczenia.
Zbiór danych składa się z 4351 wierszy (obserwacji) i 17 kolumn (atrybutów).
kable(summary(df %>% select(Max.Delta.Volume:Volumetric.Energy)))
| Max.Delta.Volume | Average.Voltage | Gravimetric.Capacity | Volumetric.Capacity | Gravimetric.Energy | Volumetric.Energy | |
|---|---|---|---|---|---|---|
| Min. : 0.00002 | Min. :-7.755 | Min. : 5.176 | Min. : 24.08 | Min. :-583.5 | Min. :-2208.1 | |
| 1st Qu.: 0.01747 | 1st Qu.: 2.226 | 1st Qu.: 88.108 | 1st Qu.: 311.62 | 1st Qu.: 211.7 | 1st Qu.: 821.6 | |
| Median : 0.04203 | Median : 3.301 | Median : 130.691 | Median : 507.03 | Median : 401.8 | Median : 1463.8 | |
| Mean : 0.37531 | Mean : 3.083 | Mean : 158.291 | Mean : 610.62 | Mean : 444.1 | Mean : 1664.0 | |
| 3rd Qu.: 0.08595 | 3rd Qu.: 4.019 | 3rd Qu.: 187.600 | 3rd Qu.: 722.75 | 3rd Qu.: 614.4 | 3rd Qu.: 2252.3 | |
| Max. :293.19322 | Max. :54.569 | Max. :2557.627 | Max. :7619.19 | Max. :5926.9 | Max. :18305.9 |
kable(summary(df %>% select(Atomic.Fraction.Charge:Max.Voltage.Step)))
| Atomic.Fraction.Charge | Atomic.Fraction.Discharge | Stability.Charge | Stability.Discharge | Steps | Max.Voltage.Step | |
|---|---|---|---|---|---|---|
| Min. :0.00000 | Min. :0.007407 | Min. :0.00000 | Min. :0.00000 | Min. :1.000 | Min. : 0.0000 | |
| 1st Qu.:0.00000 | 1st Qu.:0.086957 | 1st Qu.:0.03301 | 1st Qu.:0.01952 | 1st Qu.:1.000 | 1st Qu.: 0.0000 | |
| Median :0.00000 | Median :0.142857 | Median :0.07319 | Median :0.04878 | Median :1.000 | Median : 0.0000 | |
| Mean :0.03986 | Mean :0.159077 | Mean :0.14257 | Mean :0.12207 | Mean :1.167 | Mean : 0.1503 | |
| 3rd Qu.:0.04762 | 3rd Qu.:0.200000 | 3rd Qu.:0.13160 | 3rd Qu.:0.09299 | 3rd Qu.:1.000 | 3rd Qu.: 0.0000 | |
| Max. :0.90909 | Max. :0.993333 | Max. :6.48710 | Max. :6.27781 | Max. :6.000 | Max. :26.9607 |
W tym zbiorze można odczytać następujące cechy statystyczne:
Poniżej znajduje się analiza zbioru danych w celu zbadania rozkładów wartości poszczególnych atrybutów oraz sprawdzenia występujących między nimi korelacji.
p <- ggplot(df, aes(x = `Working.Ion`)) +
geom_bar(fill = "blue", color = "black") +
labs(
title = "Histogram głównego jonu baterii",
x = "Główny Jon",
y = "Liczba"
) +
theme_light()
ggplotly(p)
mean <- mean(df$Max.Delta.Volume, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Delta.Volume`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład maksymalnej zmiany objętości dla danego kroku",
x = "Maksymalna zmiana objętości",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Average.Voltage, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Average.Voltage`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład średniego napięcia",
x = "Średnie napięcie",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Gravimetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Capacity`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład pojemności grawimetrycznej",
x = "Pojemność grawimetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Volumetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Capacity`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład pojemności wolumetrycznej",
x = "Pojemność wolumetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Gravimetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Energy`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład energii grawimetrycznej",
x = "Energia grawimetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Volumetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Energy`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład energii wolumetrycznej",
x = "Energia wolumetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Atomic.Fraction.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Charge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład udziału atomowego składników w stanie naładowanym",
x = "Udział atomowy składników",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Atomic.Fraction.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Discharge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład udziału atomowego składników w stanie rozładowanym",
x = "Udział atomowy składników",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Stability.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Charge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład wskaźnika stabilności materiału w stanie naładowanym",
x = "Wskaźnik stabilności materiału",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Stability.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Discharge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład wskaźnika stabilności materiału w stanie rozładowanym",
x = "Wskaźnik stabilności materiału",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Steps, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Steps`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana",
x = "Liczba kroków",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
mean <- mean(df$Max.Voltage.Step, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Voltage.Step`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
labs(
title = "Rozkład maksymalnej bezwzględnej różnica między sąsiednimi krokami napięcia",
x = "Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
cor_matrix <- df %>%
select(`Max.Delta.Volume`:last_col()) %>%
cor(method="pearson")
correlation_long <- cor_matrix %>%
as.data.frame() %>%
mutate(variable1 = colnames(cor_matrix)) %>%
pivot_longer(-variable1,
names_to = "variable2",
values_to = "correlation"
) %>%
filter(variable1 > variable2)
correlation_plot <- ggplot(
correlation_long,
aes(x = variable1, y = variable2, fill = correlation)
) +
geom_tile() +
scale_fill_gradient2(
low = "blue", mid = "white", high = "red",
midpoint = 0, limits = c(-1, 1)
) +
geom_text(aes(label = sprintf("%.2f", correlation)), size = 3) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.title = element_blank()
) +
labs(fill = "Korelacja")
ggplotly(correlation_plot)
plot_correlation <- function(df, var1, var2) {
ggplot(df, aes_string(x = var1, y = var2)) +
geom_point(alpha = 0.5, color = "blue") +
geom_smooth(method = "lm", se = TRUE, color = "red", fill = "pink") +
theme_minimal() +
labs(
title = paste("Korelacja między", var1, "a", var2),
x = var1,
y = var2
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14),
axis.text = element_text(size = 10),
axis.title = element_text(size = 11)
)
}
pairs <- list(
c("Gravimetric.Energy", "Volumetric.Energy"),
c("Gravimetric.Capacity", "Volumetric.Capacity"),
c("Stability.Charge", "Stability.Discharge")
)
for (pair in pairs) {
print(plot_correlation(df, pair[1], pair[2]))
}
Aby zredukować korelacje między atrybutami, zastosowano funkcję findCorrelation z pakietu caret, ustawiając próg (cutoff) na 0.8. Funkcja ta identyfikuje atrybuty, które są silnie skorelowane i mogą zostać usunięte z analizy.
attributes_to_remove <- cor_matrix %>% findCorrelation(cutoff = 0.8, names = TRUE)
Atrybuty, które zostały wybrane do usunięcia: Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge.
Do budowy modelu predykcyjnego usunięto atrybuty Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge oraz Battery.ID. Dane zostały podzielone na zbiór uczący (70%) oraz testowy (30%). Dodatkowo, w celu oceny modelu, zastosowano ocenę krzyżową (cross-validation) z 10-krotnym podziałem zbioru danych na podzbiory.
df$Battery.Formula <- as.numeric(factor(df$Battery.Formula))
df$Working.Ion <- as.numeric(factor(df$Working.Ion))
df$Formula.Charge <- as.numeric(factor(df$Formula.Charge))
df$Formula.Discharge <- as.numeric(factor(df$Formula.Discharge))
in_training_data <- createDataPartition(y = df$Average.Voltage, p = 0.70, list = FALSE)
training_data <- df[in_training_data, ] %>% select(-c(Battery.ID, attributes_to_remove))
testing_data <- df[-in_training_data, ]
ctrl <- trainControl(method = "cv", number = 10)
Poniższy wykres przedstawia podobieństwo rozkładów danych treningowych i testowych.
ggplot() +
geom_density(aes(x = Average.Voltage, fill = "Treningowy"), data = training_data, alpha = 0.6) +
geom_density(aes(x = Average.Voltage, fill = "Testowy"), data = testing_data, alpha = 0.6) +
labs(x = "Average Voltage", y = "Gęstość", fill = "Zbiór danych") +
theme_light()
model_lm <- train(
Average.Voltage ~ .,
data = training_data,
method = "lm",
trControl = ctrl
)
model_summary <- summary(model_lm)
kable(as.data.frame(model_summary$coefficients),
caption = "Podsumowanie wyników modelu liniowego",
col.names = c("Współczynnik", "Wartość", "Standard Error", "t-Statystyka", "p-Wartość"))
| Współczynnik | Wartość | Standard Error | t-Statystyka | p-Wartość |
|---|---|---|---|---|
| (Intercept) | 3.1371173 | 0.1156145 | 27.1342824 | 0.0000000 |
| Battery.Formula | -0.0002763 | 0.0000541 | -5.1046084 | 0.0000004 |
| Working.Ion | -0.0246354 | 0.0271988 | -0.9057548 | 0.3651375 |
| Formula.Charge | -0.0001272 | 0.0000346 | -3.6720831 | 0.0002447 |
| Formula.Discharge | 0.0001570 | 0.0000430 | 3.6482901 | 0.0002684 |
| Max.Delta.Volume | 0.2317628 | 0.0253167 | 9.1545576 | 0.0000000 |
| Volumetric.Capacity | -0.0013795 | 0.0000606 | -22.7651446 | 0.0000000 |
| Volumetric.Energy | 0.0009911 | 0.0000209 | 47.5337868 | 0.0000000 |
| Atomic.Fraction.Charge | 2.5331915 | 0.4378644 | 5.7853338 | 0.0000000 |
| Atomic.Fraction.Discharge | -1.2220230 | 0.4222202 | -2.8942791 | 0.0038274 |
| Stability.Discharge | -0.4251615 | 0.0620153 | -6.8557546 | 0.0000000 |
| Steps | -0.2614434 | 0.0646566 | -4.0435684 | 0.0000540 |
| Max.Voltage.Step | 0.1054219 | 0.0589217 | 1.7891854 | 0.0736847 |
predictions <- predict(model_lm, newdata = testing_data)
post_resample <- postResample(pred = predictions,
obs = testing_data$Average.Voltage)
kable(post_resample, col.names = c("RMSE", "R^2", "MAE"), caption = "Ocena modelu - metryki jakości predykcji")
| R^2 | MAE |
|---|---|
| RMSE | 3.0194780 |
| Rsquared | 0.0708507 |
| MAE | 0.9244876 |
rmse <- sqrt(mean((testing_data$Average.Voltage - predictions)^2))
RMSE na zbiorze testowym: 3.019478
Poniższy wykres przedstawia wartości zbioru testowego oraz wartości przewidziane przez regresor.
prediction_comparison_df <- tibble(X = testing_data$Battery.ID,
actual = testing_data$Average.Voltage,
predicted = predictions)
prediction_comparison_df$Observation <- seq_along(prediction_comparison_df$X)
p <- ggplot(prediction_comparison_df, aes(x = Observation)) +
geom_line(aes(y = actual, color = "Wartość rzeczywista"), linetype = "solid", alpha = 0.5) +
geom_line(aes(y = predicted, color = "Wartość przewidziana"), linetype = "dashed", alpha = 0.5) +
labs(color = "Wartości", x = "Nr obserwacji", y = "Average Voltage [V]") +
theme_light() +
scale_x_continuous(
breaks = seq(1, nrow(prediction_comparison_df), by = 1000),
labels = scales::comma_format()
) +
scale_y_continuous(
limits = c(min(prediction_comparison_df$actual, prediction_comparison_df$predicted),
max(prediction_comparison_df$actual, prediction_comparison_df$predicted))
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
interactive_plot <- ggplotly(p) %>%
layout(
hovermode = "x unified",
xaxis = list(
title = "Nr obserwacji"
),
yaxis = list(
title = "Average Voltage [V]"
),
shapes = list(
list(
type = "line",
x0 = 0,
x1 = 1,
y0 = 0,
y1 = 1,
line = list(color = "gray", dash = "dot")
)
)
)
interactive_plot
importance <- varImp(model_lm, scale = FALSE)
importance_df <- importance$importance %>%
rownames_to_column(var = "attribute") %>%
arrange(desc(Overall))
p <- ggplot(importance_df, aes(x = reorder(attribute, Overall), y = Overall, fill = Overall)) +
geom_bar(stat = "identity") +
labs(x = "Atrybut", y = "Ważność") +
scale_fill_gradient() +
theme_light() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)